home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 551-575 / disk_575 / reqtools / oberoninterface / reqtoolsdemo.mod < prev   
Text File  |  1992-05-06  |  10KB  |  319 lines
  1. (* ------------------------------------------------------------------------
  2.   :Program.       ReqToolsDemo
  3.   :Contents.      Demonstrates use auf Nico François' reqtools.library
  4.   :Author.        Kai Bolay [kai] (C-Version by Nico François)
  5.   :Address.       Hoffmannstraße 168
  6.   :Address.       D-7250 Leonberg 1 (Germany)
  7.   :Address.       UUCP: ...!cbmvax!cbmehq!cbmger!depot1!amokle!kai
  8.   :Address.       FIDO: 2:247/706.3
  9.   :History.       v1.0 [kai] 22-Nov-91 (translated from C)
  10.   :History.       v1.0 Nico  29-Nov-91 (comment added about ta.name bug)
  11.   :Copyright.     Freeware
  12.   :Language.      Oberon
  13.   :Translator.    AMIGA OBERON v2.12e, A+L AG
  14.   :Imports.       ReqTools
  15.   :Remark.        Thanks to Nico for his great library
  16.   :Bugs.          ReqTools/Arq should support each other
  17.   :Bugs.          Font-Hook: ta.name can contain odd pointer :-(
  18. ------------------------------------------------------------------------ *)
  19.  
  20. (*********************************
  21. *                                *
  22. *  reqtools.library (V37)        *
  23. *                                *
  24. *  Release 1.0                   *
  25. *                                *
  26. *  (c) 1991 Nico François        *
  27. *                                *
  28. *  demo.c                        *
  29. *                                *
  30. *  This source is public domain  *
  31. *  in all respects.              *
  32. *                                *
  33. *********************************)
  34.  
  35. MODULE ReqToolsDemo;
  36.  
  37. IMPORT
  38.   rt: ReqTools, I: Intuition, d: Dos, e: Exec, g: Graphics, u: Utility,
  39.   y: SYSTEM;
  40.  
  41. VAR
  42.   filereq: rt.FileRequesterPtr;
  43.   fontreq: rt.FontRequesterPtr;
  44.   myhook: u.Hook;
  45.   buffer: ARRAY 128 OF CHAR;
  46.   filename: ARRAY 34 OF CHAR;
  47.   longnum, ret, color: LONGINT;
  48.   adr, adr2: y.ADDRESS;
  49.   (* $IF SmallCode *)
  50.   olduser: LONGINT;
  51.   (* $END *)
  52.  
  53. PROCEDURE myputs (str: ARRAY OF CHAR);
  54. BEGIN
  55.   IF d.Output() # NIL THEN
  56.     y.SETREG (0, d.Write (d.Output(), str, LEN (str)-1));
  57.   END;
  58. END myputs;
  59.  
  60. (* $IF DoHook *)
  61. (* $StackChk- $SaveRegs+ *)
  62. PROCEDURE *hookfunc (hook{8}: u.HookPtr;
  63.                      object{10}: e.APTR;
  64.                      message{9}: e.APTR): LONGINT;
  65. VAR
  66.   fib: d.FileInfoBlockPtr;
  67.   ta: g.TextAttrPtr;
  68.   param: POINTER TO ARRAY 2 OF e.ADDRESS;
  69. BEGIN
  70.   (* $IF SmallCode *)
  71.   y.SETREG (8+5, e.exec.thisTask^.userData);
  72.   (* $END *)
  73.   param := message;
  74.   CASE y.VAL (LONGINT, param[0]) OF
  75.   | rt.ReqHookWildFile:
  76.       (* param[1] holds address of a FileInfoBlock *)
  77.       fib := param[1];
  78.       myputs (fib^.fileName); myputs ("\n");
  79.       RETURN 0;
  80.   | rt.ReqHookWildFont:
  81.       (* param[1] holds address of a TextAttr *)
  82.       ta := param[1];
  83.       (* myputs (ta^.name^); May contain odd Pointer :-( *)
  84.       (* <odd Pointer is fault of AvailFonts function (DiskFont)> - Nico *)
  85.       myputs ("\n");
  86.       RETURN 0;
  87.   ELSE
  88.     RETURN 0;
  89.   END;
  90. END hookfunc;
  91. (* $StackChk= *)
  92. (* $END *)
  93.  
  94. BEGIN
  95.   myputs ("\nreqtools Demo\n¯¯¯¯¯¯¯¯¯¯¯¯¯\n\
  96. This program demonstrates what 'reqtools.library' \
  97. has to offer.\n");
  98.  
  99.   d.Delay (60);
  100.  
  101.   rt.vEZRequest ("'reqtools.library' offers several\ndifferent types of requesters:",
  102.                 "Let's see them", NIL, NIL);
  103.  
  104.   rt.vEZRequest ("NUMBER 1:\nThe larch :-)", "Be serious!", NIL, NIL);
  105.  
  106.   rt.vEZRequest ("NUMBER 1:\nString requester\nfunction: rt.GetString()",
  107.                 "Show me", NIL, NIL);
  108.  
  109.   buffer := "A bit of text";
  110.   IF NOT rt.GetString (buffer, 127, "Enter anything:", NIL, u.end) THEN
  111.     rt.vEZRequest ("You entered nothing :-(", "I'm sorry", NIL, NIL);
  112.   ELSE
  113.     adr := y.ADR (buffer);
  114.     rt.vEZRequest ("You entered this string:\n'%s'.",
  115.                   "So I did", NIL, NIL, adr);
  116.   END;
  117.  
  118.   rt.vEZRequest ("NUMBER 2:\nNumber requester\nfunction: rt.GetLong()",
  119.                 "Show me", NIL, NIL);
  120.  
  121.   IF NOT rt.GetLong (longnum, "Enter a number:", NIL,
  122.              rt.glShowDefault, I.LFALSE, u.end) THEN
  123.     rt.vEZRequest ("You entered nothing :-(", "I'm sorry", NIL, NIL);
  124.  
  125.   ELSE
  126.     rt.vEZRequest ("The number you entered was:\n%ld",
  127.              "So it was", NIL, NIL, longnum);
  128.   END;
  129.  
  130.   rt.vEZRequest ("NUMBER 3:\nNotification requester, the requester\n\
  131. you've been using all the time!\nfunction: rt.EZRequest()",
  132.            "Show me more", NIL, NIL);
  133.  
  134.   rt.vEZRequest ("Simplest usage: some body text and\na single centered gadget.",
  135.            "Got it", NIL, NIL);
  136.  
  137.   WHILE NOT (rt.EZRequest ("You can also use two gadgets to\n\
  138. ask the user something.\n\
  139. Do you understand?", "Of course|Not really",
  140.                 NIL, NIL) # 0) DO
  141.     rt.vEZRequest ("You are not one of the brightest are you?\n\
  142. We'll try again...",
  143.              "Ok", NIL, NIL);
  144.   END; (* WHILE *)
  145.  
  146.   rt.vEZRequest ("Great, we'll continue then.", "Fine", NIL, NIL);
  147.  
  148.   CASE rt.EZRequest ("You can also put up a requester with\n\
  149. three choices.\n\
  150. How do you like the demo so far ?",
  151.                 "Great|So so|Rubbish", NIL, NIL) OF
  152.     | 0:
  153.       rt.vEZRequest ("Too bad, I really hoped you\nwould like it better.",
  154.                "So what", NIL, NIL);
  155.     | 1:
  156.       rt.vEZRequest ("I'm glad you like it so much.", "Fine", NIL, NIL);
  157.     | 2:
  158.       rt.vEZRequest ("Maybe if you run the demo again\n\
  159. you'll REALLY like it.",
  160.                "Perhaps", NIL, NIL);
  161.   END; (* CASE *)
  162.  
  163.   ret := rt.EZRequestTags ("The number of responses is not limited to three\n\
  164. as you can see.  The gadgets are labeled with\n\
  165. the return code from rt.EZRequest().\n\
  166. Pressing Return will choose 4, note that\n\
  167. 4's button text is printed in boldface.",
  168.                   "1|2|3|4|5|0", NIL, NIL,
  169.                   rt.ezDefaultResponse, 4, u.end);
  170.   rt.vEZRequest ("You picked '%ld'.", "How true", NIL, NIL, ret);
  171.  
  172.   adr := y.ADR ("five");
  173.   rt.vEZRequest (
  174.     "You may also use C-style formatting codes in the body text.\n\
  175. Like this:\n\n\
  176. 'The number %%ld is written %%s.' will give:\n\n\
  177. The number %ld is written %s.\n\n\
  178. if you also pass '5' and '\"five\"' to rt.EZRequest().",
  179.     "Proceed", NIL, NIL, 5, adr);
  180.  
  181.   IF (I.diskInserted IN y.VAL (LONGSET, rt.EZRequestTags ("It is also possible to pass extra IDCMP flags\n\
  182. that will satisfy rt.EZRequest(). This requester\n\
  183. has had DISKINSERTED passed to it.\n\
  184. (Try insert.ing a disk).",
  185.                  "Continue", NIL, NIL,
  186.                  rt.IDCMPFlags, y.VAL (LONGINT, LONGSET {I.diskInserted}), u.end))) THEN
  187.     rt.vEZRequest ("You inserted a disk.", "I did", NIL, NIL);
  188.   ELSE
  189.     rt.vEZRequest ("You used the 'Continue' gadget\n\
  190. to satisfy the requester.", "I did", NIL, NIL);
  191.   END;
  192.  
  193.   rt.vEZRequestTags ("Finally, it is possible to specify the position\n\
  194. of the requester.\n\
  195. E.g. at the top left of the screen, like this.\n\
  196. This works for all requesters, not just rt.EZRequest()!",
  197.               "Amazing", NIL, NIL,
  198.               rt.ReqPos, rt.ReqPosTopLeftScr, u.end);
  199.  
  200.   rt.vEZRequestTags ("Alternatively, you can center the\n\
  201. requester on the screen.\n\
  202. Check out 'reqtools.doc' for all the possibilities.",
  203.               "I'll do that", NIL, NIL,
  204.               rt.ReqPos, rt.ReqPosCenterScr, u.end);
  205.  
  206.   rt.vEZRequest ("NUMBER 4:\nFile requester\n\
  207. function: rt.FileRequest()", "Demonstrate", NIL, NIL);
  208.  
  209.   filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
  210.   IF filereq # NIL THEN
  211.  
  212.     (* $IF DoHook *)
  213.     myhook.entry := hookfunc;
  214.     filereq.hook := y.ADR (myhook);
  215.     INCL (filereq.flags, rt.fReqDoWildFunc);
  216.  
  217.     (* $IF SmallCode *)
  218.     olduser := e.exec.thisTask^.userData;
  219.     e.exec.thisTask^.userData := y.REG (8+5);
  220.     (* $END *)
  221.  
  222.     (* $END *)
  223.  
  224.  
  225.     filename := "";
  226.     IF rt.FileRequest (filereq, filename, "Pick a file", u.end) THEN
  227.       adr := y.ADR (filename); adr2 := filereq.dir;
  228.        rt.vEZRequest ("You picked the file:\n'%s'\nin directory:\n'%s'",
  229.                "Right", NIL, NIL, adr, adr2);
  230.     ELSE
  231.       rt.vEZRequest ("You didn't pick a file.", "No", NIL, NIL);
  232.     END;
  233.  
  234.     (* $IF DoHook *)
  235.     (* $IF SmallCode *)
  236.     e.exec.thisTask^.userData := olduser;
  237.     (* $END *)
  238.     (* $END *)
  239.  
  240.     rt.FreeRequest (filereq);
  241.   ELSE
  242.     rt.vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  243.   END;
  244.  
  245.   rt.vEZRequest ("The file requester can be used\n\
  246. as a directory requester as well.",
  247.            "Let'see that", NIL, NIL);
  248.  
  249.   filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
  250.   IF filereq # NIL THEN
  251.     IF rt.FileRequest (filereq, filename, "Pick a directory",
  252.                  rt.fiFlags, y.VAL (LONGINT, LONGSET {rt.fReqNoFiles}), u.end) THEN
  253.       adr := filereq.dir;
  254.       rt.vEZRequest ("You picked the directory:\n'%s'",
  255.                "Right", NIL, NIL, adr);
  256.     ELSE
  257.       rt.vEZRequest ("You didn't pick a directory.", "No", NIL, NIL);
  258.     END;
  259.  
  260.     rt.FreeRequest (filereq);
  261.   ELSE
  262.     rt.vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  263.   END;
  264.  
  265.   rt.vEZRequest ("NUMBER 5:\nFont requester\nfunction: rt.FontRequest()",
  266.            "Show", NIL, NIL);
  267.  
  268.   fontreq := rt.AllocRequestA (rt.TypeFontReq, NIL);
  269.   IF fontreq # NIL THEN
  270.     fontreq.flags := LONGSET {rt.fReqStyle, rt.fReqColorFonts};
  271.  
  272.     (* $IF DoHook *)
  273.     myhook.entry := hookfunc;
  274.     fontreq.hook := y.ADR (myhook);
  275.     INCL (fontreq.flags, rt.fReqDoWildFunc);
  276.  
  277.     (* $IF SmallCode *)
  278.     olduser := e.exec.thisTask^.userData;
  279.     e.exec.thisTask^.userData := y.REG (8+5);
  280.     (* $END *)
  281.  
  282.     (* $END *)
  283.  
  284.     IF rt.FontRequest (fontreq, "Pick a font", u.end) THEN
  285.       adr := fontreq.attr.name; adr2 := fontreq.attr.ySize;
  286.       rt.vEZRequest ("You picked the font:\n'%s'\nwith size:\n'%ld'",
  287.                "Right", NIL, NIL,
  288.                adr, adr2);
  289.     ELSE
  290.       rt.vEZRequest ("You canceled.\nWas there no font you liked ?",
  291.                "Nope", NIL, NIL);
  292.     END;
  293.  
  294.     (* $IF DoHook *)
  295.     (* $IF SmallCode *)
  296.     e.exec.thisTask^.userData := olduser;
  297.     (* $END *)
  298.     (* $END *)
  299.  
  300.     rt.FreeRequest (fontreq);
  301.   ELSE
  302.     rt.vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  303.   END;
  304.  
  305.   rt.vEZRequest ("NUMBER 6:\nPalette requester\nfunction: rt.PaletteRequest()",
  306.            "Proceed", NIL, NIL);
  307.  
  308.   color := rt.PaletteRequest ("Change palette", NIL, u.end);
  309.   IF color = -1 THEN
  310.     rt.vEZRequest ("You canceled.\nNo nice colors to be picked ?",
  311.              "Nah", NIL, NIL);
  312.   ELSE
  313.     rt.vEZRequest ("You picked color number %ld.", "Sure did",
  314.              NIL, NIL, color);
  315.   END;
  316.  
  317.   myputs ("\nFinished, hope you enjoyed the demo :-)\n");
  318. END ReqToolsDemo.
  319.